home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / swags-z / sorting.swg / 0012_MODHEAP.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  5KB  |  206 lines
  1. {
  2. Ok, here is your "fastest sort routine." I spent a couple hours just tweaking
  3. and testing to make sure that it was performing 100%.
  4.  
  5. Adding $G+ only yielded a very slight speed increase but a noticeable one. (The
  6. speed results below are based on $G-.) Using anything other than Integer for
  7. Variables caused a slight degredation in performance. I would guess that
  8. Integer arithmetic is where Borland focused its optimizations on. Word and
  9. LongInt all caused performance degredation.
  10.  
  11. AND, it used to be that previous to v6 or v5.5 that multiplication was a bottle
  12. neck too, as in J := I * 3; The faster method was to say J := I+I+I; since
  13. addition is faster than multiplication. I didn't see any appreciable difference
  14. with respect to multiplication over addition here.
  15.  
  16. The following algorithm is a modified Fibonacci Heap sort With the addition of
  17. a mid-sort bounce technique. It runs almost twice the speed of the Quick Sort
  18. algorithm as posted in my last message.
  19.  
  20. It Uses considerably less stack then Quick Sort since it is non-recursive. And,
  21. for those of you who hate GOTO's, there's three in this code. Any other way I
  22. could think of would increase data and reduce performance. But you're certainly
  23. welcome to jump in and knock 'em outa there if you can!
  24.  
  25. Here are the speed results as tested on 386-40mhz:
  26.  
  27.      500 Elements - (Less than 1/10 second)
  28.     1000 Elements - 0.1 Seconds
  29.     1500 Elements - 0.2 Seconds
  30.     2000 Elements - 0.3 Seconds
  31.     5000 Elements - 1.0 Seconds
  32.     7500 Elements - 1.7 Seconds
  33.    10000 Elements - 2.3 Seconds
  34.  
  35. I modified the skeleton Program slightly to increase the number of 10 Character
  36. Strings to 10,000 so that I could test that far.
  37.  
  38. Here is the source code For the algorithm. Just "Plug" it into the skeleton
  39. Program I posted a day or so ago.
  40.  
  41. {------------------------------------------------------------------------}
  42. Procedure ModHeapSort( Total : Integer );
  43. Var
  44.   I,J,K,L : Integer;
  45.   X, Temp : Pointer;
  46.   M,M1,M2 : Integer;
  47.  
  48.   Label JumpOut;
  49.   Label Terminate;
  50.   Label SmallSort;
  51.  
  52. begin
  53.   if Total <= 4 Then
  54.     Goto SmallSort; { Too small For Split sorting }
  55.  
  56.   M  := Pred(Total) div 3;
  57.   M1 := ( M * 3 ) + 2;
  58.  
  59.   if M1 <= Total Then
  60.   begin
  61.     if M1 < Total Then
  62.       if SortArray[M1]^ < SortArray[Total]^ Then
  63.         M2 := Total
  64.       ELSE
  65.         M2 := M1
  66.     ELSE
  67.       M2 := M1;
  68.  
  69.     if SortArray[1]^ < SortArray[M2]^ Then
  70.     begin   { Swap first element to M2 }
  71.       Temp          := SortArray[1];
  72.       SortArray[1]  := SortArray[M2];
  73.       SortArray[M2] := Temp;
  74.     end;
  75.  
  76.   end; {IF M1 <= Total}
  77.  
  78.   For L := M DownTo 1 DO
  79.   begin
  80.     X := SortArray[L];
  81.     I := L;
  82.     J := I * 3;
  83.  
  84.     Repeat
  85.  
  86.       K := Pred(J);
  87.  
  88.       if SortArray[K]^ < SortArray[J]^ Then
  89.         K := J;
  90.       if SortArray[K]^ < SortArray[Succ(J)]^ Then
  91.         K := Succ(J);
  92.  
  93.       SortArray[I] := SortArray[K];
  94.       I := K;
  95.       J := I * 3;
  96.  
  97.     Until J > M1;
  98.  
  99.     J := Succ(I) div 3;
  100.  
  101.     Repeat
  102.  
  103.       if SortArray[J]^ >= SmallArrPtr(X)^ Then
  104.         Goto JumpOut;
  105.  
  106.       SortArray[I] := SortArray[J];
  107.       I := J;
  108.       J := Succ(J) div 3;
  109.  
  110.     Until J < L;
  111.  
  112.     JumpOut:
  113.       SortArray[I] := X;
  114.  
  115.   end;
  116.  
  117.   For L := M1 To Total DO
  118.   begin
  119.     X := SortArray[L];
  120.     I := L;
  121.     J := Succ(I) div 3;
  122.  
  123.     if SortArray[J]^ < SmallArrPtr(X)^ Then
  124.     begin
  125.  
  126.       Repeat
  127.         SortArray[I] := SortArray[J];
  128.         I := J;
  129.         J := Succ(J) div 3;
  130.       Until SortArray[J]^ >= SmallArrPtr(X)^;
  131.  
  132.       SortArray[I] := X;
  133.  
  134.     end; {IF}
  135.   end; {For}
  136.  
  137.   L := Total;
  138.  
  139.   While L > 4 DO
  140.   begin
  141.     X := SortArray[L];
  142.     SortArray[L] := SortArray[1];
  143.     Dec(L,1);
  144.     I := 1;
  145.     J := 3;
  146.  
  147.     Repeat
  148.       K := Pred(J);
  149.  
  150.       if SortArray[K]^ < SortArray[J]^ Then
  151.         K := J;
  152.       if SortArray[K]^ < SortArray[Succ(J)]^ Then
  153.         K := Succ(J);
  154.  
  155.       SortArray[I] := SortArray[K];
  156.       I := K;
  157.       J := I * 3;
  158.     Until J >= L;
  159.  
  160.     Dec(J,1);
  161.  
  162.     if J <= L Then
  163.     begin
  164.       if J < L Then
  165.         if SortArray[J]^ < SortArray[L]^ Then
  166.           J := L;
  167.       SortArray[I] := SortArray[J];
  168.       I := J;
  169.     end; {IF}
  170.  
  171.     J := Succ(I) div 3;
  172.  
  173.     if SortArray[J]^ < SmallArrPtr(X)^ Then
  174.     Repeat
  175.       SortArray[I] := SortArray[J];
  176.       I := J;
  177.       J := Succ(J) div 3;
  178.     Until SortArray[J]^ >= SmallArrPtr(X)^;
  179.  
  180.     SortArray[I] := X;
  181.   end;
  182.  
  183.   { Process last four remaining elements, or less than 4 to sort }
  184.   { Use "Insertion sort" method For best linear time performance }
  185.  
  186.   SmallSort :
  187.     if Total <= 4 Then
  188.       L := Total
  189.     ELSE
  190.       L := 4;
  191.  
  192.   For I := 2 To L DO
  193.   begin
  194.     X := SortArray[I];
  195.     For J := Pred(I) DownTo 1 DO
  196.       if SortArray[J]^ > SmallArrPtr(X)^ Then
  197.         SortArray[Succ(J)] := SortArray[J]
  198.       ELSE
  199.         Goto Terminate;
  200.     J := 0;
  201.  
  202.     Terminate : SortArray[Succ(J)] := X;
  203.  
  204.   end; {For I}
  205. end;
  206.